Attribute VB_Name = "文件处理"


Sub 文件批量重命名()
Dim str

flag = 0
For Each sht In ActiveWorkbook.Sheets
    If sht.Name = "文件批量重命名" Then
        flag = 1
        Exit For
    End If
Next

If flag = 0 Then    '如果不存在，则复制
    ThisWorkbook.Sheets("文件批量重命名").Copy before:=ActiveWorkbook.Sheets(1)
    MsgBox "表格模板已复制，下面请选择需要重命名的文件"
End If

With ActiveWorkbook.Sheets("文件批量重命名")
    If .Range("a3") = "" Or .Range("a3") = "M:\浅北表格助手\示例文档.xlsm" Then

        On Error Resume Next '加上这句防止用户点击取消发生的错误
        str = Application.GetOpenFilename("所有文件,*.*,PDF文件,*.pdf;*.PDF,Word文档,*.doc*,Excel表格,*.xls*", FilterIndex:=1, Title:="请选择要重命名的文件", MultiSelect:=True)
        Application.ScreenUpdating = False
        '获取文件名
        For i = LBound(str) To UBound(str)
            .Range("a" & i + 2) = str(i)
        Next
        
        '自动填充公式
        .Range("b3:h3").AutoFill destination:=.Range("b3:h" & UBound(str) + 2), Type:=xlFillDefault
        Application.ScreenUpdating = True

        MsgBox "现在请打开""文件批量重命名""表格进行编辑，编辑完成后再次点击此程序/页面按钮即可"
        .Select
    Else
        
        t = Timer
    
        For i = 3 To Range("a3").End(xlDown).Row
            On Error Resume Next '为防止重名文件
            Name Range("a" & i) As Range("h" & i)
        Next

        MsgBox "已完成重命名操作，共用时" & Timer - t & "秒！"
        Exit Sub
        
    End If
End With

End Sub


